perm filename SC2B.FOR[ZZZ,LCS] blob sn#439861 filedate 1979-05-08 generic text, type T, neo UTF8
      SUBROUTINE MOTIV
      DIMENSION LIST(78)
	COMMON/VV/LIMIT,V(1) /A/NP(27),XT(27),FRM(80),INVIS(27)
	COMMON J,L  /INP/INP(1)
	1/E/IQ(27),KL,X,ZPAR,KA,INSNUM,NNUM,JJ,JA,ISUB,NFLG
	1 ,VX(70),IAMP,K,KN,M,ML,CODE
	COMMON/B/MOT,PR,T5,NINS,I,RA,KZY,NWX,INONLY,MX,
	1 Y,Z,FNAME,MZ,N,IDALL,JC,JG,RB,IJ,IX,BW,NL,RC,W,
	1 ZZ,CHN,YY 
	1  /INTC/LPAR,IPRN,IRETRO,INVRT,ICON,LCNT,
	1 JZ,MLX,IZ,JD,LEND,ITMP,LP,ILIT,NLIT,KTMP,IC,IA
	1  /REALC/QX,PARENS,BY,ALL,QTS,RAX,RD
	1 /BLA/IBLA,KSLA,ISEMI,MINUS,ISTAR,ICOMM,ICOL,IQUES,ILESS,IQT

	EQUIVALENCE (VX1,VX(1)),(LIST,FRM(3))
	DATA IDOL/'$'/

	DO 113 L=1,LEND
	K=JD+L
C   K IS USED AT 240!!!
	JG=INP(K)
	IF(JG.NE.MINUS)GO TO 6113
	IF(CODE.EQ.-88.)CALL ERR(8)
	IRETRO=0
	INP(K)=IBLA
	GO TO 113
6113	IF(JG.NE.IDOL)GO TO 7113
C  '$' IS FOR INVERSIONS IN 'NOTES'
	IF(CODE.EQ.-88.)CALL ERR(8)
	INVRT=0
	GO TO 113
7113	IF(JG.NE.IBLA)GO TO 4113
113	CONTINUE
4113	DO 6361 JMOT=1,LCNT,3
	IF(JG.NE.LIST(JMOT))GO TO 6361
	VX1=0
	DO 40 M=JD+2,LEND
	JG=INP(M)
	IF(JG.EQ.IBLA)GO TO 40
	IF(JG.EQ.KSLA)GO TO 140
	IF(JG.EQ.ISEMI)GO TO 140
	ML=M
	GO TO 240
40	CONTINUE
240	JC=JA
	JA=-1
	INP(K)=IBLA
	CALL SCANR
	JA=JC
140	JC=1
	KN=LIST(JMOT+1)
	M=LIST(JMOT+2)+1
	IF(IRETRO.LT.0)GO TO 640
	JC=M-1
	M=KN-1
	KN=JC
	JC=-1
	IRETRO=-1 
640	IF(INVRT.LT.0)GO TO 940
C INVERSIONS NEXT
840	X=V(KN)
	IF(X.GT.-9999.)GO TO 841
C CAN'T INVERT A 'P' NUMBER.
	Z=X
	GO TO 941
841	RB=X
	X=ABS(X)+VX1
	Z=X
	IF(RB.LT.0)Z=-Z
941	V(I)=Z
C  FINDS CENTER FOR INVERSION (+TRANSP.)
	I=I+1
	IZ=IZ+1
C IZ USED FOR INTERNAL TEMPO FEATURE (FIXED 6/78)
	KN=KN+JC
	IF(V(KN-JC).NE.199.)GO TO 940
C 199. IS NOW NUM. FOR 'R' (REST)  7/78
	V(I-1)=199.
	GO TO 840

940	Z=V(KN)
	IF(Z.LT.-9999.)GO TO 540
C CAN'T INVERT OR TRANSPOSE 'P' NUMBERS.
	IF(INVRT.EQ.0)GO TO 440
	IF(VX1.EQ.0)GO TO 540
C " @Q N "  WHERE N= 1/2 STEPS IN 'NOTES' OR MULT FACTOR IN OTHERS.(NO LIT)
	IF(CODE.EQ.-88.)CALL ERR(8)
	IF(CODE.EQ.-33.)GO TO 440
	V(I)=Z*VX1
	GO TO 7361
440	IF(Z.EQ.199.)GO TO 540
C 199. IS NOW NUM. FOR 'R' (REST)  7/78
	Y=0
	RB=VX1
	IF(Z.LT.0)RB=-RB
	IF(INVRT.LT.0)GO TO 541
	RB=-RB
	RC=X
C X IS SET FURTHER BACK.
	IF(Z.LT.0)RC=-RC
C THIS STUFF FOR CHORD FEATURE
	Y=(RC-Z)*2
541	Z=Z+RB+Y
	Y=ABS(Z)
	IF(Y.LT.1.OR.Y.GT.108)CALL ERR(8)
C ERROR IF TRANSP. HAS PUSHED A NOTE NUMBER TOO HIGH OR TOO LOW.
	V(I)=Z
	GO TO 7361
540	V(I)=Z
7361	IF(JC.GT.0)GO TO 543
	IF(CODE.NE.-33)GO TO 543
	JG=I
	IF(V(I).GT.0)GO TO 543
542	Y=V(JG)
	V(JG)=V(JG-1)
	V(JG-1)=Y
C THIS STUFF FOR CHORD FEATURE
	IF(V(JG-2).GT.0)GO TO 543
	JG=JG-1
	GO TO 542
543	I=I+1
	IZ=IZ+1
C IZ USED FOR INTERNAL TEMPO FEATURE (FIXED 6/78)
	KN=KN+JC
	IF(KN.NE.M)GO TO 940

	INVRT=-1
	RB=V(I-1)
	DO 8361 L=JD,LEND
	JG=INP(L)
	KN=L
	INP(L)=IBLA
	IF(JG.EQ.KSLA)GO TO 9361
	IF(JG.EQ.IRPRN)IPRN=IPRN+1
	IF(JG.NE.ISEMI)GO TO 8361
	IAMP=-1
	GO TO 9361
8361	CONTINUE
C  ABOVE 4 LINES PUT IN 8/76. REPLACE C***********  ↓↓

9361	MLX=L+1
	IF(L.GE.LEND)GO TO 93612
C  FIX THIS & =IBLA BY CHNGING DO LOOP TO 'GO TO' AT 6721,2722
	IF(IAMP.NE.0)GO TO 797
	IF(QTS.GE.0)GO TO 797
C  GO BACK IF NOT END OF LINE
1773	L=1
C L IS FLAG UPON RETURN (GOES TO 1773 IN OTHER ROUTINE)
	RETURN
797	JZ=-1
93612	IF(IAMP.EQ.0)GO TO 93611
C*** JUNE 78 *** BELOW GOES TO CHECK ON INTERNAL TEMPO *****IF(QTS)GO TO 3013
	L=3
C L=2 WILL GO TO 9004 UPON RETURN.  L=3 GOES TO 2722.
	IF(QTS.LT.0)L=2
	RETURN
C  THESE ARE FOR "LIT" ITEMS
C  *******  DO NOT USE '@-' OR '@$' WITH 'LIT', RLIST OR RNOT****
C  NO $ WITH FUNC.  $ WITH NUMS AND RHY CAN GIVE NEG RESULT -- TRY IT!
93611	IF(KN.NE.LEND)GO TO 7773
	L=4
C L=4 GOES TO 7773 IN OTHER ROUTINE
	RETURN
7773	JZ=0
	IF(IPRN.NE.0)GO TO 1773
C ↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑PICKS UP ' @X)/ ' SITUATION.  22/6/73
	L=5
C L=5 GOES TO 236 AT HOME
	RETURN
C  LAST TIME FOR QUOTES

C   JUMPS TO END STRING OF QUOTES
6361	CONTINUE
	CALL ERR(0)
C ONLY CAN BE AN ERROR IF WE GET HERE.
	RETURN
	END

	SUBROUTINE X2703
	COMMON/VV/LIMIT,V(1) /A/NP(27),XT(27),FRM(80),INVIS(27)
	COMMON J,L /DUR/DUR(27)  /INP/INP(1)
	1/E/IQ(27),KL,X,ZPAR,KA,INSNUM,NNUM,JJ,JA,ISUB,NFLG
	1 ,VX(70),IAMP,K,KN,M,ML,CODE
	COMMON/B/MOT,PR,T5,NINS,I,RA,KZY,NWX,INONLY,MX,
	1 Y,Z,FNAME,MZ,N,IDALL,JC,JG,RB,IJ,IX,BW,NL,RC,W,
	1 ZZ,CHN,YY 
	1  /INTC/LPAR,IPRN,IRETRO,INVRT,ICON,LCNT,
	1 JZ,MLX,IZ,JD,LEND,ITMP,LP,ILIT,NLIT,KTMP,IC,IA
	1  /REALC/QX,PARENS,BY,ALL,QTS,RAX,RD
	1 /BLA/IBLA,KSLA,ISEMI,MINUS,ISTAR,ICOMM,ICOL,IQUES,ILESS,IQT
	EQUIVALENCE (VX1,VX(1)),(VX2,VX(2)),(VX3,VX(3))
2703	ML=ML+1
	VX1=0
	VX2=0
	VX3=0
	IF(N.EQ.IXX)GO TO 2704
	INP(ML)=IBLA
	INP(ML+1)=IBLA
C  WIPES OUT 'EP' IN 'REP'
2704	CALL SCANR
 	V(IJ)=3.
	V(IJ+1)=-66.0
	IF(VX1.EQ.32.)VX1=1.
	IF(VX1.EQ.0)VX1=LPAR
	IF(VX2.EQ.0)VX2=INSNUM-1
	V(IJ+2)=VX1+VX2*10000.
	KL=VX2
	IF(DUR(INSNUM).LT.0)DUR(INSNUM)=DUR(KL)
	IF(VX3.EQ.0)RETURN
	L=VX3
	ML=INSNUM+1
	DO 1018 KL=ML,L
	IF(LPAR.LE.NP(KL))GO TO 997
	IF(LPAR.LT.31)NP(KL)=LPAR
997	IF(DUR(KL).LT.0)DUR(KL)=DUR(INSNUM)
C  TO SET DUR WHEN DUPLICATING NOTES THAT END WITH 'END;;'
	V(I)=V(I-4)+10000.
	V(I+1)=3.
	V(I+2)=-66.
	V(I+3)=V(I-1)
1018	I=I+4
	RETURN
	END